;;; -*- mode: lisp -*-

;; CL-EN
;;  Copyright 2008 Ben Hyde <bhyde@pobox.com>

(in-package "ECHONEST")

(defvar *key* (read-line (open "key.txt")))

(defvar *api-root* (puri:intern-uri "http://api.echonest.com/"))

(defvar *count* 1)

(defvar *latest-xml-response* nil)


;;;; 

(defvar *xml-things* (make-hash-table :test #'equal))

(defmacro xml-info (key) `(gethash ,key *xml-things*))

(defmacro define-tag (name spelling type)
  `(let ((info '(:name ,name :spelling ,spelling :type ,type :kind :tag)))
     (setf (xml-info ',spelling) info)
     (setf (xml-info ',name) info)))

(defmacro define-attribute-property (name spelling type)
  `(let ((info '(:name ,name :spelling ,spelling :type ,type :kind :property)))
     (setf (xml-info ',spelling) info)
     (setf (xml-info ',name) info)))

(defmacro define-element-property (name spelling type &optional parent-slot value-in-text)
  `(let ((info '(:name ,name :spelling ,spelling :type ,type 
                 :parent-slot ,parent-slot 
                 :kind :attribute-element
                 :value-in-text ,(if value-in-text name nil))))
     (setf (xml-info ',spelling) info)
     (setf (xml-info ',name) info)))

;;;; Sax Handler that assembles class instance from API responses.

(defclass sax-handler (sax:default-handler)
  ((current-element :initform nil)
   last-element
   (collect-text-p :initform nil)
   (stack :initform nil)
   (all :initform nil)))

(defvar *the-sax-handler* (make-instance 'sax-handler))

(defmethod initialize-instance :after ((h sax-handler) &rest other-args)
  (declare (ignorable other-args))
  (with-slots (current-element collect-text-p stack all) h
    (setf current-element nil
          collect-text-p nil
          stack ()
          all ()))
  (slot-makunbound h 'last-element))

(defmethod sax:start-element ((h sax-handler) (namespace t) (local-name t) (qname t) (attributes t))
  (with-slots (current-element collect-text-p stack all) h
    (let* ((name-info (xml-info local-name))
           (type (getf name-info :type))
           (name (getf name-info :name)))
      (push collect-text-p stack)
      (setf collect-text-p (getf name-info :value-in-text))
      (ecase type
        ((object objects)
         ; (when value-in-text (setf collect-text-p name))
         (push
          (setf current-element 
                (make-instance name :parent current-element)) all))
        ((array plist text)
         nil)))
    (loop 
       for attribute in attributes
       as local-name = (sax:attribute-local-name attribute)
       as name-info = (xml-info local-name)
       as name = (getf name-info :name)
       as type = (getf name-info :type)
       as kind = (getf name-info :kind)
       as text-value = (sax:attribute-value attribute)
       as lisp-value = (ecase type
                         (string text-value)
                         (float (read-from-string text-value))
                         (integer (parse-integer text-value))
                         (floats (mapcar #'read-from-string (cl-ppcre:split " " text-value))))
       do
       (ecase kind
         (:property
          (setf (slot-value current-element name) lisp-value))
         (:tag
          (with-slots (tags) current-element
            (push (cons name lisp-value) tags)))))))

(defmethod sax:end-element ((h sax-handler) (namespace t) (local-name t) (qname t))
  (with-slots (current-element last-element collect-text-p stack) h
    (setf last-element current-element)
    (with-slots (parent) current-element
      (when parent
        ;; store child into parent
        (let* ((info (xml-info local-name))
               (type (getf info :type))
               (slot (getf info :parent-slot)))
          (ecase type
            (object
             (setf (slot-value parent slot) current-element)
             (setf current-element parent))
            (objects
             (push current-element (slot-value parent slot))
             (setf current-element parent))
            ((array plist text)
             ;; all set
             nil)))))
    (setf collect-text-p (pop stack))))

(defmethod sax:characters ((h sax-handler) (data t))
  (with-slots (current-element collect-text-p) h
    (when collect-text-p
      (setf (slot-value current-element collect-text-p) 
            (ecase (getf (xml-info collect-text-p) :type)
              (text data)
              (array
               (map 'vector #'read-from-string
                    (cl-ppcre:all-matches-as-strings "[\\d.]+" data))))))))

;;;; Bottleneck for all API request/response traffic.

(defvar *rng-schema* (cxml-rng:parse-compact (probe-file "rng/analysis.rng")))

(defun do-request (op method parameters)
  (multiple-value-bind (body errcode)
      (drakma:http-request 
       (puri:merge-uris (concatenate 'string op "?api_key=" *key*) *api-root*)
       :method method
       :content-length t ;; [1]
       :parameters parameters)
    (incf *count*) ;; [2]
    (unless (= 200 errcode)
      (error "Request error code: ~D body: ~S" errcode body))
    (intern-response body)))

;; notes
;; [1] Echonest can't handle chunked?
;; [2] Possibly the incf should be before the request?

(defun intern-response (xml-text)
  (initialize-instance *the-sax-handler*)
    (cxml:parse xml-text
                (cxml-rng:make-validator
                 *rng-schema*
                 *the-sax-handler*))
    (slot-value *the-sax-handler* 'last-element))


